home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 6
/
006.d81
/
visible bubble s
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
14KB
|
560 lines
10 rem ********************************
20 rem * v i s i b l e *
30 rem * b u b b l e s o r t *
40 rem * *
50 rem * by: thomas g. pink *
60 rem * *
70 rem * revised for the c-64 by: *
80 rem * alan w. gardner *
90 rem * 8/84 *
95 rem ********************************
100 :
110 rem a$()array of words to sort
115 rem h horizontal tab
120 rem k for-next counter
125 rem l length of string to center
130 rem m number of menu items
135 rem m$()menu array
140 rem mt$ menu title
145 rem n number of words in sort ary
150 rem p for-next counter for pause
155 rem p$()array for program lines
160 rem pa pause factor
165 rem pfl flag to see/not program
170 rem r for-next counter in movers
175 rem st$ temp. storage string
180 rem tfl flag for speed(pauses)
185 rem v vertical tab
190 rem vfl flag to see/not visual sort
195 rem w$ column heading
200 rem x$ string used in centering
202 rem ss address to position cursor
205 :
210 rem *******************************
220 rem * *
230 rem * m a i n p r o g r a m *
240 rem * *
250 rem *******************************
255 :
260 print"[147]":ss=65520:poke783,peek(783)and254
270 dim m$(4),a$(10),b$(10),p$(8)
280 gosub 3540: rem credits
290 gosub 3250: rem read menu - m$()
300 gosub 3340: rem read sort - b$()
310 gosub 3400: rem read prg array
320 gosub 2720: rem menu
330 gosub 2190: rem sort
340 goto 320: (NULL) back to menu
350 :
360 rem *******************************
370 rem * *
380 rem * end of main program *
390 rem * *
400 rem *******************************
405 :
410 rem *******************************
420 rem * *
430 rem * u s e r p a u s e *
440 rem * *
450 rem *******************************
455 :
460 ifpeek(198)<=0then475
465 poke198,0
470 wait198,1:poke198,0
475 return
480 :
490 rem *******************************
495 rem * *
500 rem * move sub-i to storage *
505 rem * *
510 rem *******************************
515 :
520 if pfl=1thenprint"":poke781,20:poke782,1:sysss:print""p$(4)"[146]"
525 print"[146]"
530 for r=8to39-len(a$(i))step1
535 ifr-8<len(a$(i))thenpoke781,v+i:poke782,8+len(a$(i)):sysss:printright$(a$(i),r-7);
540 ifr-8>=len(a$(i))thenpoke781,v+i:poke782,r-0:sysss:print" ";a$(i);
545 ifsfl=1thenc=1
550 iftfl<>0thenpa=2:gosub 1160: rem pause
555 gosub 390
560 next r
565 ifsfl=1thenc=5
570 iftfl<>0thenpa=10:gosub 1160: rem pause
575 ifpfl=1thenpoke781,20:poke782,1:sysss:printp$(4)
580 return
585 :
590 rem ** move sub-j to sub-i **
595 rem
600 ifpfl=1thenprint"":poke781,21:poke782,1:sysss:print""p$(5)"[146]"
602 iftfl<>0thenpa=50:gosub1160
604 forr=8to19
610 ifr-8<len(a$(j))thenpoke781,v+j:poke782,8+len(a$(j)):sysss:printright$(a$(j),r-7);
620 ifr-8>=len(a$(j))thenpoke781,v+j:poke782,r:sysss:print" ";a$(j);
630 ifsfl=1thenc=1
640 iftfl<>0thenpa=2:gosub1160
650 gosub 390
660 next r
670 ifsfl=1thenc=5
680 iftfl<>0thenpa=10:gosub 1160
690 forr=v+j-1tov+istep-1
700 poke781,r:poke782,20:sysss:printa$(j);
710 poke781,r+1:poke782,20:sysss:print" ";
720 ifsfl=1thenc=1
730 iftfl<>0thenpa=2:gosub 1160
740 gosub 390
750 nextr
760 ifsfl=1thenc=5
770 iftfl<>0thenpa=10:gosub 1160
780 forr=19to8step-1
790 poke781,v+i:poke782,r:sysss:printa$(j);" ";
800 ifsfl=1thenc=1
810 iftfl<>0thenpa=2:gosub 1160
820 gosub 390
830 next r
840 ifsfl=1thenc=5
850 iftfl<>0thenpa=10:gosub 1160
860 ifpfl=1thenpoke781,21:poke782,1:sysss:printp$(5)
870 return
875 :
880 rem*******************************
882 rem* *
884 rem* move storage to sub-j *
886 rem* *
888 rem*******************************
889 :
890 ifpfl=1thenprint"":poke781,22:poke782,1:sysss:print""p$(6)"[146]"
900 iftfl<>0thenpa=50:gosub 1160
910 forr=v+i+1tov+j
920 poke781,r:poke782,40-len(st$):sysss:printst$
930 ifr>v+i+1thenpoke781,r-1:poke782,30:sysss:print" ";
940 ifsfl=1thenc=1
950 iftfl<>0thenpa=2:gosub 1160
960 gosub 390
970 next r
980 ifsfl=1thenc=5
990 iftfl<>0thenpa=10:gosub 1160
1000 forr=40-len(st$)to8step-1
1010 poke781,v+j:poke782,r:sysss:printst$;" ";
1020 ifsfl=1thenc=1
1030 iftfl<>0thenpa=2:gosub1160
1040 gosub 390
1050 next r
1060 ifsfl=1thenc=5
1070 iftfl<>0thenpa=10:gosub1160
1080 ifpfl=1thenpoke781,22:poke782,1:sysss:printp$(6)
1090 return
1100 rem *****************************
1102 rem * *
1104 rem * sound routine *
1106 rem * *
1108 rem *****************************
1109 :
1110 rem not implemented (yet)
1150 rem *****************************
1152 rem * *
1154 rem * pause *
1156 rem * *
1158 rem *****************************
1159 :
1160 forp=1to (pa*tfl*5):nextp
1170 return
1175 :
1180 rem *****************************
1182 rem * *
1184 rem * check is ok *
1186 rem * *
1188 rem *****************************
1189 :
1190 ifvfl=0thengoto1270
1195 :
1200 iftfl<>0thenpa=25:gosub 1160
1210 poke781,v+j:poke782,20:sysss:print"ok[146]";
1220 rem sound of the bell
1230 iftfl<>0thenpa=50:gosub 1160
1240 gosub 390
1250 ifpfl=1thenpoke781,19:poke782,1:sysss:print""p$(3)"[146]";
1260 poke781,v+j:poke782,20:sysss:print" ";
1270 return
1275 :
1280 rem ******************************
1282 rem * *
1284 rem * swap 'em *
1286 rem * *
1288 rem ******************************
1289 :
1290 iftfl<>0thenpa=25:gosub 1160
1300 poke781,v+j:poke782,20:sysss:print"swap 'em[146]";
1310 ifsfl=1thenc=30
1320 iftfl<>0thenpa=50:gosub 1160
1330 gosub 390
1340 ifpfl=1thenpoke781,19:poke782,1:sysss:printp$(3)"[146]";
1350 poke781,v+j:poke782,20:sysss:print" ";
1360 return
1365 :
1370 rem *****************************
1372 rem * *
1374 rem * move st$ & inverses a$ *
1376 rem * *
1378 rem *****************************
1379 :
1380 poke781,v+i-3:poke782,33:sysss:print" "
1390 poke781,v+i-2:poke782,33:sysss:print"storage";
1400 poke781,v+i-1:poke782,29:sysss:print" ";
1410 print"";
1420 poke781,v+i:poke782,40-len(st$):sysss:print""st$
1430 ifpfl=0thenpoke781,v+i:poke782,4:sysss:print""i;"[146][157] ";a$(i):goto1460
1440 poke781,v+i:poke782,2:sysss:print"a$(i)=";tab(8);a$(i)
1450 ifpfl=1thenpoke781,5:poke782,17:sysss:print""i
1460 print"[146]"
1470 return
1475 :
1480 rem ******************************
1482 rem * *
1484 rem * inverse, pause & normal p$ *
1486 rem * *
1488 rem ******************************
1489 :
1490 print"";
1500 ifpfl=1andi=1andnuloop=1thenpoke781,17:poke782,1:sysss:printp$(1)
1510 ifpfl=1andi<>1andnuloop=1thenpoke781,24:poke782,1:sysss:printp$(8);
1520 print"[146]";
1530 iftfl<>0andnuloop=1thenpa=50:gosub 1160
1540 ifpfl=1andi=1andnuloop=1thenpoke781,17:poke782,1:sysss:printp$(1)
1550 ifpfl=1andi<>1andnuloop=1thenpoke781,24:poke782,1:sysss:printp$(8);
1560 return
1565 :
1570 rem ******************************
1572 rem * *
1574 rem * inverse for a$(j), p$ *
1576 rem * *
1578 rem ******************************
1579 :
1580 print"":poke783,peek(783)and254
1590 ifpfl=0thenpoke783,peek(783)and254
1595 ifpfl=0thenpoke781,v+j:poke782,4:sysss:print""j;"[146][157] ";a$(j):goto1610
1600 poke781,v+j:poke782,2:sysss:print"a$(j)=";tab(8);""a$(j)
1610 ifpfl=1andnuloop=1thenpoke781,18:poke782,1:sysss:print""p$(2)
1620 ifpfl=1andnuloop=0thenpoke781,23:poke782,1:sysss:print""p$(7);
1630 ifpfl=1andnuloop=1thenpoke781,5:poke782,25:sysss:print""
1640 ifpfl=1andnuloop=0thenpoke781,5:poke782,25:sysss:print""j
1650 print"[146]"
1660 iftfl<>0thenpa=50:gosub1160
1670 gosub 390
1680 ifpfl=1andnuloop=0thenpoke781,23:pok